week5-ex
show data
head(wildschwein_BE)## # A tibble: 6 x 8
## TierID TierName CollarID DatetimeUTC E N day
## <int> <chr> <int> <dttm> <dbl> <dbl> <chr>
## 1 1 Ueli 12272 2014-05-28 21:01:14 2570390. 1204820. Tag
## 2 1 Ueli 12272 2014-05-28 21:15:18 2570389. 1204826. Abenddaemmerung
## 3 1 Ueli 12272 2014-05-28 21:30:13 2570391. 1204821. Abenddaemmerung
## 4 1 Ueli 12272 2014-05-28 21:45:11 2570388. 1204826. Abenddaemmerung
## 5 1 Ueli 12272 2014-05-28 22:00:33 2570388. 1204819. 1Nachtviertel
## 6 1 Ueli 12272 2014-05-28 22:15:16 2570384. 1204828. 1Nachtviertel
## # … with 1 more variable: moonilumination <dbl>head(wildschwein_metadata)## TierID TierName CollarID Sex Gewicht Study_area
## 1 1 Ueli 12272 m 79.5 Bern
## 2 1 Ueli 12844 m 91.0 Bern
## 3 2 Sabine 12275 f 62.0 Bern
## 4 5 Nicole 12273 f 50.0 Bern
## 5 10 Caroline 13570 f 68.0 Bern
## 6 10 Caroline 13969 f 58.0 Bernhead(wildschwein_overlap_temp)## # A tibble: 6 x 4
## TierID TierName CollarID Groups
## <int> <chr> <int> <dbl>
## 1 1 Ueli 12272 1
## 2 2 Sabine 12275 2
## 3 5 Nicole 12273 2
## 4 10 Caroline 13969 2
## 5 11 Isabelle 12274 2
## 6 16 Rosa 13972 2head(schreck_agenda)## # A tibble: 6 x 9
## id datum_on datum_off modus lautstaerke intervall
## <chr> <dttm> <dttm> <chr> <dbl> <dbl>
## 1 WSS_201… 2014-04-01 00:00:00 2014-06-20 00:00:00 standa… 100 15
## 2 WSS_201… 2014-07-23 00:00:00 2014-09-19 00:00:00 standa… 100 15
## 3 WSS_201… 2014-04-26 00:00:00 2014-08-08 00:00:00 standa… 50 4
## 4 WSS_201… 2014-04-26 00:00:00 2014-08-08 00:00:00 standa… 100 15
## 5 WSS_201… 2014-09-19 00:00:00 2014-10-18 00:00:00 standa… 50 20
## 6 WSS_201… 2014-05-01 00:00:00 2014-10-28 00:00:00 standa… 33 15
## # … with 3 more variables: ausrichtung_min <int>, ausrichtung_max <int>,
## # phase <dbl>head(schreck_locations)## # A tibble: 6 x 9
## id region flurname kultur installationsho… zaun jagddruck lat lon
## <chr> <chr> <chr> <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 WSS_2… elfing… rüti weizen&h… 1.8 nein mittel 47.5 8.10
## 2 WSS_2… elfing… steiach… weizen 1.95 nein mittel 47.5 8.12
## 3 WSS_2… elfing… schlott… weizen&s… 1.8 nein mittel 47.5 8.11
## 4 WSS_2… fanel tannenh… kartoffe… 1.8 ja gering 47.0 7.06
## 5 WSS_2… fanel tannenh… karotten… 1.8 nein gering 47.0 7.06
## 6 WSS_2… fanel fanelac… kartoffe… 1.8 nein gering 47.0 7.04Schreck prepare
schreck_locations_ch <- schreck_locations %>% st_as_sf(coords = c("lon", "lat"), crs = CRS("+init=epsg:4326"), remove = FALSE) #%>% st_transform(crs = 2056)
schreck_locations_ch <- schreck_locations_ch %>% st_transform(crs = 2056)
schreck_locations_ch <- schreck_locations_ch %>% filter(lat < 47.2 & lon < 7.5)
coordsne <- unlist(st_geometry(schreck_locations_ch)) %>% matrix(ncol=2,byrow=TRUE) %>% as_tibble() %>% setNames(c("N","E"))## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if `.name_repair` is omitted as of tibble 2.0.0.
## Using compatibility `.name_repair`.schreck_locations_ch$N <- coordsne$E
schreck_locations_ch$E <- coordsne$N
#join
schreck_locations_ch <- schreck_locations_ch %>% left_join(schreck_agenda, by=c("id"="id"))
schreck_locations_ch$wid <- c(1:25)
schreck_locations_ch <- schreck_locations_ch %>% mutate(wid=as.character(wid))Get common data, show examples
# Get common samples
head(wildschwein_BE)## # A tibble: 6 x 8
## TierID TierName CollarID DatetimeUTC E N day
## <int> <chr> <int> <dttm> <dbl> <dbl> <chr>
## 1 1 Ueli 12272 2014-05-28 21:01:14 2570390. 1204820. Tag
## 2 1 Ueli 12272 2014-05-28 21:15:18 2570389. 1204826. Abenddaemmerung
## 3 1 Ueli 12272 2014-05-28 21:30:13 2570391. 1204821. Abenddaemmerung
## 4 1 Ueli 12272 2014-05-28 21:45:11 2570388. 1204826. Abenddaemmerung
## 5 1 Ueli 12272 2014-05-28 22:00:33 2570388. 1204819. 1Nachtviertel
## 6 1 Ueli 12272 2014-05-28 22:15:16 2570384. 1204828. 1Nachtviertel
## # … with 1 more variable: moonilumination <dbl>head(schreck_locations_ch)## Simple feature collection with 6 features and 20 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: 2569629 ymin: 1204878 xmax: 2571106 ymax: 1207100
## Projected CRS: CH1903+ / LV95
## # A tibble: 6 x 21
## id region flurname kultur installationsho… zaun jagddruck lat lon
## <chr> <chr> <chr> <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 WSS_2… fanel tannenhof kartoffe… 1.8 ja gering 47.0 7.06
## 2 WSS_2… fanel tannenhof karotten… 1.8 nein gering 47.0 7.06
## 3 WSS_2… fanel fanelach… kartoffe… 1.8 nein gering 47.0 7.04
## 4 WSS_2… fanel fanelach… kartoffe… 1.8 nein gering 47.0 7.04
## 5 WSS_2… fanel tannenhof weizen 1.8 nein gering 47.0 7.06
## 6 WSS_2… fanel tannenhof weizen 1.8 nein gering 47.0 7.06
## # … with 12 more variables: geometry <POINT [m]>, N <dbl>, E <dbl>,
## # datum_on <dttm>, datum_off <dttm>, modus <chr>, lautstaerke <dbl>,
## # intervall <dbl>, ausrichtung_min <int>, ausrichtung_max <int>, phase <dbl>,
## # wid <chr>sabi <- wildschwein_BE %>% filter(TierName=="Sabine")
# Filter night data
sabi <- sabi %>% filter(day != "Tag" & !is.na(day)) # only night gps
s1 <- schreck_locations_ch[5,]
sabi <- sabi %>% filter(DatetimeUTC > first(s1$datum_on) & DatetimeUTC < first(s1$datum_off))
sabi <- sabi %>% mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2))
sabi <- sabi %>% filter(dist < 400)
sabi <- sabi %>% mutate(trip = ifelse(hour(DatetimeUTC) > 16, day(DatetimeUTC)+1, day(DatetimeUTC)))
ggplot() +
geom_path(data=sabi %>% filter(trip<11), aes(x=E, y=N, color=factor(trip))) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) 
# Get example 1
wildboar_closeup <- wildschwein_BE %>%
filter(TierName=="Sabine" & DatetimeUTC > as_datetime('2015-06-09 22:30:43') & DatetimeUTC < as_datetime('2015-06-10 14:30:43')) %>%
mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2)) %>% mutate(triptime0 = as.numeric((DatetimeUTC - min(DatetimeUTC))) / 60)
ggplot() +
geom_path(data=wildboar_closeup, aes(x=E, y=N, color=triptime0)) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) 
# Get example 2
wildboar_closeup1 <- wildschwein_BE %>%
filter(TierName=="Sabine" & DatetimeUTC > as_datetime('2015-06-08 18:30:43') & DatetimeUTC < as_datetime('2015-06-09 14:30:43')) %>%
mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2)) %>% mutate(triptime0 = as.numeric((DatetimeUTC - min(DatetimeUTC))) / 60) %>% arrange(.,triptime0)
ggplot() +
geom_path(data=wildboar_closeup1, aes(x=E, y=N, color=triptime0)) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) 
# Get example 2
wildboar_closeup2 <- wildschwein_BE %>%
filter(TierName=="Sabine" & DatetimeUTC > as_datetime('2015-06-07 18:30:43') & DatetimeUTC < as_datetime('2015-06-08 14:30:43')) %>%
mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2)) %>% mutate(triptime0 = as.numeric((DatetimeUTC - min(DatetimeUTC))) / 60) %>% arrange(.,triptime0)
ggplot() +
geom_path(data=wildboar_closeup2, aes(x=E, y=N, color=triptime0)) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) 
# Plot
head(schreck_locations_ch)## Simple feature collection with 6 features and 20 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: 2569629 ymin: 1204878 xmax: 2571106 ymax: 1207100
## Projected CRS: CH1903+ / LV95
## # A tibble: 6 x 21
## id region flurname kultur installationsho… zaun jagddruck lat lon
## <chr> <chr> <chr> <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 WSS_2… fanel tannenhof kartoffe… 1.8 ja gering 47.0 7.06
## 2 WSS_2… fanel tannenhof karotten… 1.8 nein gering 47.0 7.06
## 3 WSS_2… fanel fanelach… kartoffe… 1.8 nein gering 47.0 7.04
## 4 WSS_2… fanel fanelach… kartoffe… 1.8 nein gering 47.0 7.04
## 5 WSS_2… fanel tannenhof weizen 1.8 nein gering 47.0 7.06
## 6 WSS_2… fanel tannenhof weizen 1.8 nein gering 47.0 7.06
## # … with 12 more variables: geometry <POINT [m]>, N <dbl>, E <dbl>,
## # datum_on <dttm>, datum_off <dttm>, modus <chr>, lautstaerke <dbl>,
## # intervall <dbl>, ausrichtung_min <int>, ausrichtung_max <int>, phase <dbl>,
## # wid <chr>ggplot() +
geom_sf(data = schreck_locations_ch, color='black') +
geom_sf(data=wildschwein_BE %>% filter(TierName=="Sabi"), color="blue")
ggplot() +
geom_point(data = schreck_locations_ch, aes(x=E, y=N, color='red')) +
geom_point(data=sabi, aes(x=E, y=N,color="blue")) + ylim(1200000, 1210000) + xlim(2568000, 2578000)## Warning: Removed 4 rows containing missing values (geom_point).
sabi %>% filter(day==10)## # A tibble: 0 x 10
## # … with 10 variables: TierID <int>, TierName <chr>, CollarID <int>,
## # DatetimeUTC <dttm>, E <dbl>, N <dbl>, day <chr>, moonilumination <dbl>,
## # dist <dbl>, trip <dbl>Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.
Adding closest active schreck (+ distance) to each observation
### data
w<-wildschwein_BE %>% mutate(date = as.Date(DatetimeUTC),
time= format(DatetimeUTC, format = "%H:%M:%S"),
hour= as.integer(format(DatetimeUTC, format = "%H"))+
as.integer(format(DatetimeUTC, format = "%M"))/60)
sl<-schreck_locations
###
s<-data.frame(schreck_locations_ch) ## I had to transform it to a data frame, otherwise something was weird about the coordinates (geometry)
###
s1<-s[!duplicated(s$id),c("id","N","E")] # list with all Schrecks and their location
# Set id to w
w <- w %>% mutate(id = row_number())
## reduce data to certain time frame
w1<-w %>%
filter (day!="Tag"&!is.na(day) &
((DatetimeUTC > as.Date("2014-05-01") & DatetimeUTC < as.Date("2014-07-04")) |
(DatetimeUTC > as.Date("2015-05-20") & DatetimeUTC < as.Date("2015-07-01")) |
(DatetimeUTC > as.Date("2016-04-04") & DatetimeUTC < as.Date("2016-10-04")) |
(DatetimeUTC > as.Date("2017-04-26") & DatetimeUTC < as.Date("2017-11-18"))))
nrow(w1)## [1] 38039#for(j in 1:nrow(w1)){
### look only at Schrecks that were active on that day
# s_on<-s[s$datum_on < w1[j,]$DatetimeUTC & s$datum_off > w1[j,]$DatetimeUTC,]
#if(nrow(s_on)==0)
# {w1[j,"closest_schreck"]<-"no_Schreck_on"}
#else{
#for(i in 1:nrow(s_on)){ ## calculate difference between current observation (j) and each schreck location
#s_on[i,"diff"]<-sqrt((w1[j,"N"]-s_on[i,"N"])^2+(w1[j,"E"]-s_on[i,"E"])^2)} ## add difference of current observation to location into file
#### look at the distance of the closest Schreck, only use it if less than 400m
#if(min(s_on$diff)>400){
#w1[j,"closest_schreck"]<-"no_Schreck_witin_400m"}
#else{
#w1[j,"closest_schreck"]<-s_on[s_on$diff==min(s_on$diff),"id"] ## add closest schreck to each wild boar location
#w1[j,"distance_to_closest_schreck"]<-s_on[s_on$diff==min(s_on$diff),"diff"]
#}}}
# Save data.frame to spare time
#write.csv(w1, "wildboar_loop.csv")
w1 <- read_delim("wildboar_loop.csv",",")## Warning: Missing column names filled in: 'X1' [1]##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## X1 = col_double(),
## TierID = col_double(),
## TierName = col_character(),
## CollarID = col_double(),
## DatetimeUTC = col_datetime(format = ""),
## E = col_double(),
## N = col_double(),
## day = col_character(),
## moonilumination = col_double(),
## id = col_double(),
## closest_schreck = col_character(),
## distance_to_closest_schreck = col_double()
## )w1 <- w1 %>% mutate(hour= as.integer(format(DatetimeUTC, format = "%H")),
tripdate= ifelse(hour < 12, as.Date(DatetimeUTC)-1, as.Date(DatetimeUTC)),
tripdate2 = as.Date(tripdate, origin="1970-01-01"))
# Merge close wildschweinschreck gps data to origin wildboar
w <- w %>% left_join(w1 %>% dplyr::select(id, closest_schreck, distance_to_closest_schreck), by="id")
w <- w %>% mutate(closest_schreck=
ifelse(is.na(closest_schreck), "no_Schreck_witin_400m", closest_schreck))
#add tripdate
w <- w %>% mutate(hour= as.integer(format(DatetimeUTC, format = "%H")),
tripdate= ifelse(hour < 12, as.Date(DatetimeUTC)-1, as.Date(DatetimeUTC)),
tripdate2 = as.Date(tripdate, origin="1970-01-01"))
w %>% dplyr::select(DatetimeUTC, tripdate2)## # A tibble: 327,255 x 2
## DatetimeUTC tripdate2
## <dttm> <date>
## 1 2014-05-28 21:01:14 2014-05-28
## 2 2014-05-28 21:15:18 2014-05-28
## 3 2014-05-28 21:30:13 2014-05-28
## 4 2014-05-28 21:45:11 2014-05-28
## 5 2014-05-28 22:00:33 2014-05-28
## 6 2014-05-28 22:15:16 2014-05-28
## 7 2014-05-28 22:30:14 2014-05-28
## 8 2014-05-28 22:45:09 2014-05-28
## 9 2014-05-28 23:00:12 2014-05-28
## 10 2014-05-28 23:15:08 2014-05-28
## # … with 327,245 more rowsSeparation of the wildboar trips
####### create trips: two hour before and two hours after first observation at "Abenddaemmerung" (i.e. presumed start of Schrecks)
#####
# split time and day in separate columns:
w1$Date <- as.Date(w1$DatetimeUTC)
## order data frame by animal and time
w1<-w1[order(w1$TierName) & order(w1$DatetimeUTC),]
#
##### Create trips: with shorest distance to schreck (each day) ########################################
# split time and day in separate columns:
w1$Date <- as.Date(w1$DatetimeUTC)
## order data frame by animal and time
w1<-w1[order(w1$TierName) & order(w1$DatetimeUTC),]
## empty column for trip id
w$tripID_dist<-"NA"
w$start_dist<-"no"
animals<-unique(w1$TierName)
for(j in 1:length(animals)){
days<-unique(w1[w1$TierName==animals[j] & !is.na(w1$TierName),]$tripdate2)
if(length(days)!=0){
for(i in 1:length(days)){
n<-w1[w1$TierName==animals[j] & w1$tripdate2==days[i],]
if(nrow(n[!is.na(n$distance_to_closest_schreck),])==0){nmin<-NA} else{
nmin<-min(n$distance_to_closest_schreck,na.rm=T)}
if(!is.na(nmin)){ ## only continue if nmin is not NA
if(nmin<=400){ ## only continue if minimal distance to schreck is less than 400m
n<-n[n$distance_to_closest_schreck==nmin & !is.na(n$distance_to_closest_schreck),]
w[w$TierName==animals[j] & (w$DatetimeUTC >= n$DatetimeUTC-2*60*60) & (w$DatetimeUTC <= n$DatetimeUTC+2*60*60),"tripID_dist"]<-paste(animals[j],i, sep="_")
w[w$TierName==animals[j] & w$DatetimeUTC==n$DatetimeUTC,"start_dist"]<-"yes"
}}}}}## Warning in `>=.default`(w$DatetimeUTC, n$DatetimeUTC - 2 * 60 * 60): Länge des längeren Objektes
## ist kein Vielfaches der Länge des kürzeren Objektes## Warning in `<=.default`(w$DatetimeUTC, n$DatetimeUTC + 2 * 60 * 60): Länge des längeren Objektes
## ist kein Vielfaches der Länge des kürzeren Objektes## Warning in `==.default`(w$DatetimeUTC, n$DatetimeUTC): Länge des längeren Objektes
## ist kein Vielfaches der Länge des kürzeren Objektesw <- w %>% group_by(TierID, tripdate2) %>% mutate(isTrip= max(tripID_dist) != 'NA',
tripIDnight = ifelse((hour < 9.1 | hour >= 17.9)&isTrip,
max(tripID_dist), NA)) %>% ungroup()
### list of all trips based on closest distance per day and two hours before and after
trips_dist<-unique(w$tripIDnight)
head(trips_dist)## [1] "Ueli_1" NA "Ueli_2" "Ueli_3" "Ueli_4" "Ueli_5"Wildschewinschreck
s1 <- schreck_locations_ch[5,]
wildboar_closeup <- wildschwein_BE %>%
filter(TierName=="Sabine" & DatetimeUTC > as_datetime('2015-06-08 18:30:43') & DatetimeUTC < as_datetime('2015-06-09 10:30:43')) %>%
mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2)) %>% mutate(triptime0 = as.numeric((DatetimeUTC - min(DatetimeUTC))) / 60) %>% arrange(.,triptime0)
schreck_orientation <- s1 %>% mutate(length=lautstaerke*lautstaerke/100)
rad2deg <- function(rad) {(rad * 180) / (pi)}
deg2rad <- function(deg) {(deg * pi) / (180)}
schreck_orientation$asurichtung_mean <- (schreck_orientation$ausrichtung_max-
schreck_orientation$ausrichtung_min) / 2 +
schreck_orientation$ausrichtung_min
schreck_orientation$ausrichung_meanE = schreck_orientation$E[1] + schreck_orientation$length[1] * 2*
cos(deg2rad(360-270-(schreck_orientation$asurichtung_mean[1])))
schreck_orientation$ausrichung_meanN = schreck_orientation$N[1] + schreck_orientation$length[1] *2*
sin(deg2rad(360-270-(schreck_orientation$asurichtung_mean[1])))
schreck_orientation$ausrichung_minE = schreck_orientation$E[1] + schreck_orientation$length[1] *
cos(deg2rad(360-270-schreck_orientation$ausrichtung_min[1]))
schreck_orientation$ausrichung_minN = schreck_orientation$N[1] + schreck_orientation$length[1] *
sin(deg2rad(360-270-schreck_orientation$ausrichtung_min[1]))
schreck_orientation$ausrichung_maxE = schreck_orientation$E[1] + schreck_orientation$length[1] *
cos(deg2rad(360-270-schreck_orientation$ausrichtung_max[1]))
schreck_orientation$ausrichung_maxN = schreck_orientation$N[1] + schreck_orientation$length[1] *
sin(deg2rad(360-270-schreck_orientation$ausrichtung_max[1]))
x_coord <- c(schreck_orientation$E[1], schreck_orientation$ausrichung_minE[1],
schreck_orientation$ausrichung_meanE[1],
schreck_orientation$ausrichung_maxE[1], schreck_orientation$E[1])
y_coord <- c(schreck_orientation$N[1], schreck_orientation$ausrichung_minN[1],
schreck_orientation$ausrichung_meanN[1],
schreck_orientation$ausrichung_maxN[1], schreck_orientation$N[1])
#p = Polygon(cbind(x_coord, y_coord))
#ps = Polygons(list(p),1)
#sps = SpatialPolygons(list(ps))
#plot(sps)
#schreck_orientation$polygon[1] = sps[1]
poly <- st_polygon(list(matrix(c(x_coord, y_coord),ncol=2, byrow=FALSE))) #%>% st_geometry(poly) %>% st_set_crs(2056)
pos <- data.frame(x=x_coord, y=y_coord, id=c(1,2,3,4,5))
#schreck_orientation$polygon <- poly
ggplot() +
geom_path(data=wildboar_closeup, aes(x=E, y=N, color=triptime0)) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) +
geom_point(data = schreck_orientation, aes(x=ausrichung_meanE, y=ausrichung_meanN),
colour="brown", size=2) +
geom_polygon(data=pos, aes(x=x, y = y, fill="orange", alpha=0.4))
Wilddboar scare effect properties
# Get all trips
trips <- w %>% filter(!is.na(tripIDnight)) %>% group_by(tripIDnight)
trips ## # A tibble: 6,661 x 20
## # Groups: tripIDnight [113]
## TierID TierName CollarID DatetimeUTC E N day
## <int> <chr> <int> <dttm> <dbl> <dbl> <chr>
## 1 1 Ueli 12272 2014-05-28 21:01:14 2570390. 1204820. Tag
## 2 1 Ueli 12272 2014-05-28 21:15:18 2570389. 1204826. Abenddaemmeru…
## 3 1 Ueli 12272 2014-05-28 21:30:13 2570391. 1204821. Abenddaemmeru…
## 4 1 Ueli 12272 2014-05-28 21:45:11 2570388. 1204826. Abenddaemmeru…
## 5 1 Ueli 12272 2014-05-28 22:00:33 2570388. 1204819. 1Nachtviertel
## 6 1 Ueli 12272 2014-05-28 22:15:16 2570384. 1204828. 1Nachtviertel
## 7 1 Ueli 12272 2014-05-28 22:30:14 2570393. 1204824. 1Nachtviertel
## 8 1 Ueli 12272 2014-05-28 22:45:09 2570585. 1205044. 1Nachtviertel
## 9 1 Ueli 12272 2014-05-28 23:00:12 2570576. 1205044. 1Nachtviertel
## 10 1 Ueli 12272 2014-05-28 23:15:08 2570566. 1205047. 1Nachtviertel
## # … with 6,651 more rows, and 13 more variables: moonilumination <dbl>,
## # date <date>, time <chr>, hour <int>, id <dbl>, closest_schreck <chr>,
## # distance_to_closest_schreck <dbl>, tripdate <dbl>, tripdate2 <date>,
## # tripID_dist <chr>, start_dist <chr>, isTrip <lgl>, tripIDnight <chr># calculate properties of scarce (approaching rate, speed)
s1 <- schreck_locations_ch[5,]
#wildboar_trip <- wildschwein_BE %>%
# filter(TierName=="Sabine" & DatetimeUTC > as_datetime('2015-06-08 19:30:43') &
# DatetimeUTC < as_datetime('2015-06-09 08:30:43')) %>%
# mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2)) %>%
# mutate(triptime0 = as.numeric((DatetimeUTC - min(DatetimeUTC))) / 60) %>% arrange(.,triptime0)
wildboar_trip <- w %>% filter(tripIDnight=="Olga_6") %>% ungroup() %>%
mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2)) %>%
mutate(triptime0 = as.numeric((DatetimeUTC - min(DatetimeUTC))) / 60) %>% arrange(.,triptime0)
wildboar_trip_scared <- data.frame(matrix(ncol = 22, nrow = 0))
x <- c("id", "scareEffect", "triptime0", "approachingRate", "approachingRateRelative",
"approachingRateAbsolute", "speed", "sinousity", "sinousityPre", "acceleration", "speedDiff3",
"dist","E", "N","x", "y",
"closest_schreck", "scared", "tripIDnight", "DatetimeUTC", "hour", "day")
colnames(wildboar_trip_scared) <- x
# Line distance function
dist2d <- function(a,b,c)
{
v1 <- b - c
v2 <- a - b
m <- cbind(v1,v2)
d <- abs(det(m))/sqrt(sum(v1*v1))
}
for (u in 1:length(unique(trips$tripIDnight)))
{
wildboar_trip <- trips %>% filter(tripIDnight==unique(trips$tripIDnight)[u])
# Only take full trips
if (length(wildboar_trip$TierID) > 61)
{
s1 <- schreck_locations_ch %>% filter(id == max(wildboar_trip$closest_schreck))
wildboar_trip <- wildboar_trip %>%
mutate(dist = sqrt((first(s1$N)-N)^2+(first(s1$E)-E)^2)) %>%
mutate(triptime0 = as.numeric((DatetimeUTC - min(DatetimeUTC))) / 60,
triptimeDiff = (triptime0-lag(triptime0))*60,
distanceAbsolute = ((E- lag(E))^2 + (N-lag(N))^2)^0.5) %>% arrange(.,triptime0)
# Calculate approaching rate
wildboar_trip <- wildboar_trip %>% mutate(approachingRate = lag(dist)-dist,
approachingRateAbsolute =
approachingRate / (triptimeDiff),
approachingRateRelative =
approachingRate / (distanceAbsolute))
# Calculate speed & acceleration
wildboar_trip <- wildboar_trip %>%
mutate(speed = round(distanceAbsolute / triptimeDiff, 4),
acceleration = round((lead(speed)-speed) * 60 / lead(triptimeDiff), 4),
speedDiff3 = round(((speed+lead(speed)+lead(speed, 2))/3 -
(lag(speed)+lag(speed, 2)+lag(speed, 3)/3)), 4))
# Relative coordinates (trajectory)
wildboar_trip <- wildboar_trip %>% mutate(x=E-first(s1$E), y=N-first(s1$N))
coords <- data.frame(x = wildboar_trip$x,
y = wildboar_trip$y,
times = wildboar_trip$triptime0)
# Set all sinousitiy to 0
wildboar_trip$sinousity = replicate(length(coords$x), NA)
wildboar_trip$sinousityPre = replicate(length(coords$x), NA)
for (i in 3:(length(coords$x)-2)) {
# Create a trajectory from the coordinates
trj <- TrajFromCoords(coords[(i):(i+3),])
trj2 <- TrajFromCoords(coords[(i-3):(i),])
# Rescale stepsize
trj_re <- TrajRediscretize(trj, 1)
trj_re2 <- TrajRediscretize(trj2, 1)
# Calculate sinousity
wildboar_trip$sinousity[i] = TrajSinuosity(trj_re, compass.direction = TRUE) %>%
round(digits = 4)
wildboar_trip$sinousityPre[i] = TrajSinuosity(trj_re2, compass.direction = TRUE) %>%
round(digits = 4)
}
# Get proximity of movement
#schreckPoint <- c(s1$E,s1$N)
wildboar_trip <- wildboar_trip %>%
mutate(linedist = ((x^2+y^2)^0.5 + ((x-lag(x))^2+(y-lag(y))^2)^0.5)/2)
#ifelse(is.na(lag(x)) | is.na(x), NA,
# dist2d(c(0, 0), c(E,N), c(lag(E), lag(N)))))
#((x^2+y^2)^0.5 + ((x-lag(x))^2+(y-lag(y))^2)^0.5)/2)
# Calculate scareEffect and classify scare
wildboar_trip <- wildboar_trip %>% mutate(sinousity = ifelse(is.na(sinousity), max(sinousity), sinousity),
scareEffect = - normalize(approachingRateAbsolute)
+ normalize(acceleration) - normalize(sinousity),
isScared = scareEffect > 6.5,
scared = lead(isScared))
wildboar_trip_scared <- wildboar_trip_scared %>%
rbind(wildboar_trip %>%
dplyr::select(id, scareEffect, triptime0, approachingRate, approachingRateRelative,
approachingRateAbsolute, speed, sinousity, sinousityPre, acceleration,
speedDiff3, dist, E, N, x, y, closest_schreck, scared, tripIDnight,
DatetimeUTC,
hour, day))
}
}
head(wildboar_trip_scared)## # A tibble: 6 x 22
## # Groups: tripIDnight [1]
## id scareEffect[,1] triptime0 approachingRate approachingRateRelative
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 15062 NA 0 NA NA
## 2 15063 NA 15.1 3.68 0.717
## 3 15064 -0.879 30.0 3.38 0.488
## 4 15065 1.02 45.1 0.606 0.111
## 5 15066 1.37 60.6 -6.72 -0.901
## 6 15067 2.61 75.1 9.57 0.869
## # … with 17 more variables: approachingRateAbsolute <dbl>, speed <dbl>,
## # sinousity <dbl>, sinousityPre <dbl>, acceleration <dbl>, speedDiff3 <dbl>,
## # dist <dbl>, E <dbl>, N <dbl>, x <dbl>, y <dbl>, closest_schreck <chr>,
## # scared <lgl[,1]>, tripIDnight <chr>, DatetimeUTC <dttm>, hour <int>,
## # day <chr># Scaled values
wildboar_trip_scared <- wildboar_trip_scared %>%
mutate(
approachingRateAbsoluteS = (approachingRateAbsolute-min(approachingRateAbsolute, na.rm = TRUE)) /
(max(approachingRateAbsolute, na.rm = TRUE)- min(approachingRateAbsolute, na.rm = TRUE)),
approachingRateRelativeS = (approachingRateRelative-min(approachingRateRelative, na.rm = TRUE)) /
(max(approachingRateRelative, na.rm = TRUE)- min(approachingRateRelative, na.rm = TRUE)),
accelerationS = (acceleration-min(acceleration, na.rm = TRUE))/
(max(acceleration, na.rm = TRUE)-min(acceleration, na.rm = TRUE)),
sinousityS = (sinousity-min(sinousity, na.rm = TRUE))/
(max(sinousity, na.rm = TRUE)-min(sinousity, na.rm = TRUE)),
sinousityDiff = sinousity - sinousityPre,
sinousityDiffS = (sinousityDiff - min(sinousityDiff, na.rm=TRUE) /
(max(sinousityDiff, na.rm = TRUE)- min(sinousityDiff, na.rm = TRUE))),
distanceS = (dist-min(dist, na.rm = TRUE))/(max(dist, na.rm = TRUE)-min(dist, na.rm = TRUE)),
speedDiff3S = (speedDiff3-min(speedDiff3, na.rm=TRUE)) /
(max(speedDiff3, na.rm=TRUE)-min(speedDiff3, na.rm = TRUE)),
approachingRateRelativeSlead = lead(approachingRateRelativeS),
scare2effect = accelerationS - sinousityS - distanceS - lead(approachingRateRelativeS) + speedDiff3S,
scary=scare2effect>1.1,
scary=ifelse(is.na(scary), FALSE, scary))
#
wildboar_scared <- wildboar_trip_scared %>% filter(scary)
w <- w %>% left_join(wildboar_trip_scared %>%
dplyr::select(id, scareEffect, triptime0, approachingRate,
approachingRateRelative, approachingRateAbsolute, speed, sinousity,
dist, x, y, scared), by="id")## Adding missing grouping variables: `tripIDnight`wildboar_trip_scared_True <- wildboar_trip_scared %>%
group_by(tripIDnight) %>%
mutate(tripScared = sum(scary, na.rm = TRUE)) %>%
filter(tripScared > 0)Plot all found shrecks
# Amount of scared trips
unique(wildboar_trip_scared_True$tripIDnight)## [1] "Ueli_110" "Ueli_133" "Ueli_137" "Sabine_18" "Sabine_21" "Sabine_23"
## [7] "Sabine_24" "Sabine_27" "Sabine_28" "Sabine_29" "Sabine_31" "Sabine_32"
## [13] "Sabine_33" "Sabine_35" "Sabine_36" "Sabine_39" "Sabine_40" "Sabine_41"
## [19] "Sabine_42" "Sabine_43" "Ruth_17" "Ruth_40" "Ruth_43" "Olga_1"
## [25] "Olga_4" "Olga_11" "Olga_14" "Olga_16" "Olga_19" "Olga_20"
## [31] "Olga_22" "Olga_23" "Olga_24" "Olga_25" "Olga_26" "Olga_27"
## [37] "Olga_28" "Olga_31" "Olga_33" "Olga_34" "Olga_35" "Olga_36"
## [43] "Olga_37" "Olga_38" "Olga_40" "Olga_41" "Olga_43"for (u in 1:length(unique(wildboar_trip_scared_True$tripIDnight)))
{
test <- wildboar_trip_scared_True %>% filter(tripIDnight==unique(wildboar_trip_scared_True$tripIDnight)[u])
print(first(test$DatetimeUTC))
print(first(test$tripIDnight))
print(ggplot(data=test) +
geom_line( aes(x=triptime0, y=distanceS, alpha=0.8), color="blue")+
geom_line( aes(x=triptime0,
y=lead(approachingRateAbsoluteS)), alpha=0.8, color="green")+
geom_line( aes(x=triptime0, y=approachingRateRelativeS, alpha=0.8), color="red")+
geom_line( aes(x=triptime0, y=accelerationS, alpha=0.8), color="orange")+
geom_line( aes(x=triptime0, y=speedDiff3S, alpha=0.8), color="lightblue")+
geom_line( aes(x=triptime0, y=sinousityS, alpha=0.8), color="purple")+
geom_line( aes(x=triptime0, y=scareEffect/4, alpha=0.4), color="black") +
geom_line(aes(x=triptime0, y= scare2effect, alpha=0.8), color="brown"))
print(ggplot() +
geom_path(data= test, aes(x=E, y=N, color=triptime0)) +
geom_point(data = schreck_locations_ch %>% filter(id == max(test$closest_schreck)),
aes(x=E, y=N), colour="black", size=2) +
geom_point(data = test %>% filter(scary), aes(x=E, y=N), color="red"))
}## [1] "2016-06-14 18:00:10 UTC"
## [1] "Ueli_110"
## [1] "2016-07-07 18:00:19 UTC"
## [1] "Ueli_133"
## [1] "2016-07-11 18:00:11 UTC"
## [1] "Ueli_137"
## [1] "2015-06-05 18:00:34 UTC"
## [1] "Sabine_18"
## [1] "2015-06-08 18:01:16 UTC"
## [1] "Sabine_21"
## [1] "2015-06-10 18:00:20 UTC"
## [1] "Sabine_23"
## [1] "2015-06-11 18:00:12 UTC"
## [1] "Sabine_24"
## [1] "2015-06-14 18:00:44 UTC"
## [1] "Sabine_27"
## [1] "2015-06-15 18:00:22 UTC"
## [1] "Sabine_28"
## [1] "2015-06-16 18:00:44 UTC"
## [1] "Sabine_29"
## [1] "2015-06-18 18:00:12 UTC"
## [1] "Sabine_31"
## [1] "2015-06-19 18:00:22 UTC"
## [1] "Sabine_32"
## [1] "2015-06-20 18:00:09 UTC"
## [1] "Sabine_33"
## [1] "2015-06-22 18:00:44 UTC"
## [1] "Sabine_35"
## [1] "2015-06-23 18:00:08 UTC"
## [1] "Sabine_36"
## [1] "2015-06-26 18:00:15 UTC"
## [1] "Sabine_39"
## [1] "2015-06-27 18:00:10 UTC"
## [1] "Sabine_40"
## [1] "2015-06-28 18:00:15 UTC"
## [1] "Sabine_41"
## [1] "2015-06-29 18:00:23 UTC"
## [1] "Sabine_42"
## [1] "2015-06-30 18:01:08 UTC"
## [1] "Sabine_43"
## [1] "2015-06-04 18:00:44 UTC"
## [1] "Ruth_17"
## [1] "2015-06-27 18:02:34 UTC"
## [1] "Ruth_40"
## [1] "2015-06-30 18:00:43 UTC"
## [1] "Ruth_43"
## [1] "2015-05-19 18:00:18 UTC"
## [1] "Olga_1"
## [1] "2015-05-22 18:00:15 UTC"
## [1] "Olga_4"
## [1] "2015-05-29 18:00:12 UTC"
## [1] "Olga_11"
## [1] "2015-06-01 18:00:44 UTC"
## [1] "Olga_14"
## [1] "2015-06-03 18:00:16 UTC"
## [1] "Olga_16"
## [1] "2015-06-06 18:00:11 UTC"
## [1] "Olga_19"
## [1] "2015-06-07 18:00:12 UTC"
## [1] "Olga_20"
## [1] "2015-06-09 18:00:38 UTC"
## [1] "Olga_22"
## [1] "2015-06-10 18:00:15 UTC"
## [1] "Olga_23"
## [1] "2015-06-11 18:00:20 UTC"
## [1] "Olga_24"
## [1] "2015-06-12 18:00:16 UTC"
## [1] "Olga_25"
## [1] "2015-06-13 18:00:15 UTC"
## [1] "Olga_26"
## [1] "2015-06-14 18:00:38 UTC"
## [1] "Olga_27"
## [1] "2015-06-15 18:00:21 UTC"
## [1] "Olga_28"
## [1] "2015-06-18 18:00:10 UTC"
## [1] "Olga_31"
## [1] "2015-06-20 18:00:13 UTC"
## [1] "Olga_33"
## [1] "2015-06-21 18:00:09 UTC"
## [1] "Olga_34"
## [1] "2015-06-22 18:00:10 UTC"
## [1] "Olga_35"
## [1] "2015-06-23 18:00:12 UTC"
## [1] "Olga_36"
## [1] "2015-06-24 18:00:13 UTC"
## [1] "Olga_37"
## [1] "2015-06-25 18:00:17 UTC"
## [1] "Olga_38"
## [1] "2015-06-27 18:00:11 UTC"
## [1] "Olga_40"
## [1] "2015-06-28 18:00:17 UTC"
## [1] "Olga_41"
## [1] "2015-06-30 18:00:37 UTC"
## [1] "Olga_43"
test <- wildboar_trip_scared_True %>% filter(tripIDnight=='Ueli_110')
print(first(test$DatetimeUTC))## [1] "2016-06-14 18:00:10 UTC" print(first(test$tripIDnight))## [1] "Ueli_110" print(ggplot(data=test) +
geom_line( aes(x=triptime0, y=distanceS), color="blue")+
geom_line( aes(x=triptime0,
y=approachingRateAbsoluteS), color="green")+
#geom_line( aes(x=triptime0, y=normalize(approachingRateRelative)), color="yellow")+
geom_line( aes(x=triptime0, y=accelerationS), color="orange")+
#geom_line( aes(x=triptime0, y=normalize(speed)), color="red")+
geom_line( aes(x=triptime0, y=sinousityS), color="purple")+
geom_line( aes(x=triptime0, y=scareEffect/4), color="black") +
geom_line(aes(x=triptime0, y= scare2effect), color="brown"))## Warning: Removed 1 row(s) containing missing values (geom_path).## Warning: Removed 2 row(s) containing missing values (geom_path).## Warning: Removed 4 row(s) containing missing values (geom_path).
## Warning: Removed 4 row(s) containing missing values (geom_path).## Warning: Removed 6 row(s) containing missing values (geom_path).
ggplot() +
geom_path(data=test, aes(x=E, y=N, color=triptime0)) +
geom_point(data = schreck_locations_ch %>%
filter(id == max(test$closest_schreck)), aes(x=E, y=N), colour="black", size=2) +
geom_point(data = test %>% filter(scary), aes(x=E, y=N), color="red")
ggplot() +
geom_path(data=wildboar_trip, aes(x=E, y=N, color=approachingRate)) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) +
geom_point(data = wildboar_trip %>% filter(scared | scared), aes(x=E, y=N), color="red")
ggplot() +
geom_path(data=wildboar_trip, aes(x=E, y=N, color=speed)) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) +
geom_point(data = wildboar_trip %>% filter(scared | scared), aes(x=E, y=N), color="red")
ggplot() +
geom_path(data=wildboar_trip, aes(x=E, y=N, color=sinousity)) +
geom_point(data = s1, aes(x=E, y=N), colour="black", size=2) +
geom_point(data = wildboar_trip %>% filter(scared | scared), aes(x=E, y=N), color="red")
#ggplot(data=test) +
# geom_line( aes(x=triptime0, y=dist*100/max(dist), color="blue")+
# geom_line( aes(x=triptime0, y=normalize(approachingRateAbsolute)), color="green")+
#geom_line( aes(x=triptime0, y=normalize(approachingRateRelative)), color="yellow")+
# geom_line( aes(x=triptime0, y=normalize(acceleration)), color="orange")+
#geom_line( aes(x=triptime0, y=normalize(speed)), color="red")+
#geom_line( aes(x=triptime0, y=normalize(sinousity)), color="purple")+
#geom_line( aes(x=triptime0, y=scareEffect), color="black"))